home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PSTUI100 / PTUIBUT.PAS < prev    next >
Pascal/Delphi Source File  |  1993-02-09  |  9KB  |  338 lines

  1. {
  2.  
  3.                                                       ╔══════════════════╗
  4.                                                       ║  PGUI Graphic    ║
  5.                                                       ║  Button Include  ║
  6.                                                       ║    Rev.  1.00    ║
  7.                                                       ╚══════════════════╝
  8.  
  9. }
  10.  
  11. Procedure ButtonChain.Init;
  12. Begin
  13.   Root     :=NIL;
  14.   Total    :=0;
  15.   Buttons  :=NIL;
  16. End;
  17.  
  18. Function ButtonChain.Position:Word;
  19.  
  20. Var
  21.   B     :Pointer;
  22.   X     :Word;
  23.  
  24. Begin
  25.   X:=1;
  26.   B:=Buttons;
  27.   Buttons:=Root;
  28.  
  29.   While (Buttons<>NIL) And (Buttons^.Next<>NIL) And (B<>Buttons) do
  30.   Begin
  31.     Inc(X);
  32.     Buttons:=Buttons^.Next;
  33.   End;
  34.  
  35.   If (B<>Buttons) Or (B=NIL) Then Position:=0;
  36.   Buttons:=B;
  37. End;
  38.  
  39. Function ButtonChain.Number:Word;
  40. Begin
  41.   If Buttons=NIL Then
  42.     Number:=0
  43.   Else
  44.     Number:=Buttons^.Number;
  45. End;
  46.  
  47. Procedure ButtonChain.GotoPosition(Here:Word);
  48.  
  49. Var
  50.   X     :Word;
  51.  
  52. Begin
  53.   If Here=0 Then
  54.   Begin
  55.     Buttons:=NIL;
  56.     Exit;
  57.   End;
  58.  
  59.   X:=1;
  60.   Buttons:=Root;
  61.   While (Buttons<>NIL) And (Buttons^.Next<>NIL) And (X<Here) do
  62.   Begin
  63.     Buttons:=Buttons^.Next;
  64.     Inc(X);
  65.   End;
  66. End;
  67.  
  68. Procedure ButtonChain.GotoNumber(ButtonNumber:Word);    {NIL if not found}
  69. Begin
  70.   Buttons:=Root;
  71.   While (Buttons<>NIL) And (ButtonNumber<>Buttons^.Number) do
  72.     Buttons:=Buttons^.Next;
  73. End;
  74.  
  75. Function ButtonChain.NewButtonNumber:Word;
  76.  
  77. Var
  78.   Highest:Word;
  79.  
  80. Begin
  81.   Buttons:=Root;
  82.   Highest:=0;
  83.   While Buttons<>NIL do
  84.   Begin
  85.     Highest:=Buttons^.Number;
  86.     Buttons:=Buttons^.Next;
  87.   End;
  88.   If Highest>65500 Then
  89.   Begin
  90.     Repeat
  91.       Highest:=Random(65499)+1;
  92.       Buttons:=Root;
  93.       While (Buttons<>NIL) And (Highest<>0) do
  94.       Begin
  95.         If Highest=Buttons^.Number Then Highest:=0;
  96.         Buttons:=Buttons^.Next;
  97.       End;
  98.     Until Highest<>0;
  99.     NewButtonNumber:=Highest;
  100.   End
  101.   Else
  102.     NewButtonNumber:=Highest+1;
  103. End;
  104.  
  105. Procedure ButtonChain.Add(X1, Y1, X2, Y2:Word;
  106.                           Special:Boolean; Key:Char);
  107.  
  108. { ╔════════════════════════════════════════════════════════════════════════╗ }
  109. { ║                                                                        ║ }
  110. { ║   The button is added to the list.  Button coordinates are at X1,Y1    ║ }
  111. { ║   to X2,Y2.  The equivalent key press is in Key.  Special is True      ║ }
  112. { ║   if the key returned if preceeded by a character 0.                   ║ }
  113. { ║                                                                        ║ }
  114. { ║   Background is the background colour, Picture is a possible           ║ }
  115. { ║   Button picture and it returns a the button's number.                 ║ }
  116. { ║                                                                        ║ }
  117. { ╚════════════════════════════════════════════════════════════════════════╝ }
  118.  
  119. Var
  120.   P   :ButtonListPtr;   {New Button}
  121.  
  122. Begin
  123.   New(P);
  124.   P^.X1         :=X1;
  125.   P^.Y1         :=Y1;
  126.   P^.X2         :=X2;
  127.   P^.Y2         :=Y2;
  128.   P^.Number     :=NewButtonNumber;
  129.   P^.Special    :=Special;
  130.   P^.Key        :=Key;
  131.   P^.Next       :=NIL;
  132.  
  133.   GotoPosition(65535);
  134.  
  135.   If Root=NIL Then
  136.   Begin
  137.     Root:=P;
  138.     Buttons:=P;
  139.   End
  140.   Else
  141.   Begin
  142.     Buttons^.Next:=P;
  143.     Buttons:=P;
  144.   End;
  145.   Inc(Total);
  146. End;
  147.  
  148. Procedure ButtonChain.WaitForClick(Var X, Y:Word;Var MouseButtons:Byte;
  149.                                    Var Held,Doubled,Special:Boolean; Var Key:Char);
  150.  
  151. { ╔════════════════════════════════════════════════════════════════════════╗ }
  152. { ║                                                                        ║ }
  153. { ║  This procedure will return which of the currently active buttons      ║ }
  154. { ║  has been selected.  If a user presses the key equivalent of a         ║ }
  155. { ║  button or moves the mouse onto a button and clicks, the procedure     ║ }
  156. { ║  returns that button's key press.  It also checks for a double click.  ║ }
  157. { ║                                                                        ║ }
  158. { ║  If Key=#255 then no valid key was received.                           ║ }
  159. { ║                                                                        ║ }
  160. { ║  It will return the co-ordinates if no button was clicked on.          ║ }
  161. { ║                                                                        ║ }
  162. { ║  If a double click was selected, Double is set to True, else False.    ║ }
  163. { ║                                                                        ║ }
  164. { ║  Special is set to True if and only if a "Special" key was pressed.    ║ }
  165. { ║  A "Special" key is a key pressed that is preceeded by a NUL or        ║ }
  166. { ║  character 0.  Example, the cursor keys.                               ║ }
  167. { ║                                                                        ║ }
  168. { ║  Which mouse buttons are being pressed is also returned.               ║ }
  169. { ║                                                                        ║ }
  170. { ╚════════════════════════════════════════════════════════════════════════╝ }
  171.  
  172. Var
  173.   Z,W            :Word;
  174.   FoundAgain,
  175.   Found          :Boolean;      {Has the user pressed a button}
  176.   CheckDouble    :Pointer;
  177.   C              :Char;         {Key Pressed}
  178.  
  179. Begin
  180.   C      :=Chr(255);
  181.   Found  :=False;
  182.   Buttons:=Root;
  183.  
  184.   Begin
  185.     Special:=False;
  186.  
  187.     If Mouse.Active Then
  188.     Begin
  189.       Mouse.GetClick(X,Y,Z,W,MouseButtons,Held,Doubled);
  190.       X:=(X Div MouseGranularity) + 1;
  191.       Y:=(Y Div MouseGranularity) + 1;
  192.       While (Not Found) And (Buttons<>NIL) And (Not KeyPressed) do
  193.       Begin
  194.         If (X>=Buttons^.X1) And (X<=Buttons^.X2) And
  195.            (Y>=Buttons^.Y1) And (Y<=Buttons^.Y2) Then Found:=True;
  196.         If Not Found Then Buttons:=Buttons^.Next;
  197.       End;
  198.       If KeyPressed Then C:=UpCase(ReadKey);
  199.  
  200.       FoundAgain:=False;
  201.       CheckDouble:=Buttons;
  202.       If Doubled Then
  203.       Begin
  204.         Buttons:=Root;
  205.         While Not FoundAgain And (Buttons<>NIL) do
  206.         Begin
  207.           If (Z>=Buttons^.X1) And (Z<=Buttons^.X2) And
  208.              (W>=Buttons^.Y1) And (W<=Buttons^.Y2) Then FoundAgain:=True;
  209.           If Not FoundAgain Then Buttons:=Buttons^.Next;
  210.         End;
  211.         If CheckDouble<>Buttons Then
  212.         Begin
  213.           Doubled:=False;
  214.           If Buttons=NIL Then Buttons:=CheckDouble;
  215.         End;
  216.       End;
  217.     End;     {Now, for Mouse and No Mouse}
  218.  
  219.     If Not Found Then Buttons:=Root;
  220.     If Not Mouse.Active Then C:=UpCase(ReadKey);
  221.     If C=Chr(0) Then If KeyPressed Then
  222.     Begin
  223.       C:=ReadKey;
  224.       Special:=True;
  225.     End;
  226.     If C=Chr(0) Then C:=Chr(255);
  227.  
  228.     While Not Found And (Buttons<>NIL) do
  229.     Begin
  230.       If (C=Buttons^.Key) And (Special=Buttons^.Special) Then Found:=True;
  231.       If Not Found Then Buttons:=Buttons^.Next;
  232.     End;
  233.   End;
  234.  
  235.   If Found Then
  236.   Begin
  237.     Special:=Buttons^.Special;
  238.     Key    :=Buttons^.Key;
  239.   End
  240.   Else
  241.   Begin
  242.     Key    :=#255;
  243.     Buttons:=NIL;
  244.   End;
  245. End;
  246.  
  247. Procedure ButtonChain.Move(X,Y:Integer;ButtonNumber:Word);
  248. Begin
  249.   GotoNumber(ButtonNumber);
  250.   If Buttons=NIL Then Exit;
  251.   Inc(Buttons^.X1,X);
  252.   Inc(Buttons^.X2,X);
  253.   Inc(Buttons^.Y1,Y);
  254.   Inc(Buttons^.Y2,Y);
  255. End;
  256.  
  257. Procedure ButtonChain.MoveAll(X,Y:Integer);
  258.  
  259. Var
  260.   OldBut  :Pointer;
  261.  
  262. Begin
  263.   OldBut :=Buttons;
  264.   Buttons:=Root;
  265.   While Buttons<>NIL do
  266.   Begin
  267.     Inc(Buttons^.X1,X);
  268.     Inc(Buttons^.X2,X);
  269.     Inc(Buttons^.Y1,Y);
  270.     Inc(Buttons^.Y2,Y);
  271.     Buttons:=Buttons^.Next;
  272.   End;
  273.   Buttons:=OldBut;
  274. End;
  275.  
  276. Procedure ButtonChain.KillFrom;
  277.  
  278. { ╔════════════════════════════════════════════════════════════════════════╗ }
  279. { ║  Removes *some* buttons from memory.                                   ║ }
  280. { ╚════════════════════════════════════════════════════════════════════════╝ }
  281.  
  282. Var
  283.   Q     :Pointer;
  284.  
  285. Begin
  286.   While Buttons<>NIL do
  287.   Begin
  288.     Q:=Buttons^.Next;
  289.     Dispose(Buttons);
  290.     Buttons:=Q;
  291.     Dec(Total);
  292.   End;
  293.   If Total=0 Then Root:=NIL;
  294. End;
  295.  
  296. Procedure ButtonChain.KillAll;
  297.  
  298. { ╔════════════════════════════════════════════════════════════════════════╗ }
  299. { ║  Removes all buttons from memory.                                      ║ }
  300. { ╚════════════════════════════════════════════════════════════════════════╝ }
  301.  
  302. Begin
  303.   Buttons:=Root;
  304.   KillFrom;
  305. End;
  306.  
  307. Procedure ButtonChain.KillOne;
  308.  
  309. { ╔════════════════════════════════════════════════════════════════════════╗ }
  310. { ║  Removes *one* button from memory, if it exists.                       ║ }
  311. { ╚════════════════════════════════════════════════════════════════════════╝ }
  312.  
  313. Var
  314.   Q     :ButtonListPtr;
  315.   Here  :Word;
  316.  
  317. Begin
  318.   Here:=Position;
  319.   If Here>Total Then Exit;
  320.   If Here=1 Then
  321.   Begin
  322.     Root:=Buttons^.Next;
  323.     Dispose(Buttons);
  324.     Buttons:=Root;
  325.     Dec(Total);
  326.   End
  327.   Else
  328.   Begin
  329.     GotoPosition(Here-1);
  330.     Q:=Buttons^.Next;
  331.     Buttons^.Next:=Buttons^.Next^.Next;
  332.     Dispose(Q);
  333.     Dec(Total);
  334.   End;
  335. End;
  336.  
  337. { Copyright 1993, Michael Gallias }
  338.